﻿<!-- #Include File="../Include/Admin_Onlogin.asp" -->
<%
strFileName = "Admin_UploadFile_Clear.asp"
Dim sqlAuth, rsAuth, PurviewID
sqlAuth = "Select AuthID From Admin_Auth Where href='Admin/" & strFileName & "' Order By sort Asc,AuthID Asc"
Call Exec(rsAuth,sqlAuth,2)
If rsAuth.BOF And rsAuth.EOF Then
	PurviewID = 0
Else
	PurviewID = rsAuth(0)
	CheckPurview PurviewID,0
End If
rsAuth.Close
Set rsAuth = Nothing
Server.ScriptTimeOut = 9999999
Dim theFolder, theSubFolder, theFile
Dim strFiles, ItemIntro, UpFileType
Select Case Action
Case "DoClear"
	sqlAuth = "Select AuthID From Admin_Auth Where pid="&PurviewID&" And href='UploadFile/Clear' Order By sort Asc,AuthID Asc"
	Call Exec(rsAuth,sqlAuth,2)
	If rsAuth.BOF And rsAuth.EOF Then
		CheckPurview 0,1
	Else
		CheckPurview rsAuth(0),1
	End If
	rsAuth.Close
	Set rsAuth = Nothing
    Call DoClear
Case Else
    Call Clear
End Select
If FoundErr = True Then
    Call WriteErrMsg(ErrMsg, ComeUrl)
End If
Call CloseConn()

Sub Clear()
	Response.Write "<!DOCTYPE html>" & vbCrLf
	Response.Write "<head>" & vbCrLf
	Response.Write "<title>附件清理</title>" & vbCrlf
	Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
	Response.Write "<meta name='viewport' content='width=device-width, initial-scale=1, maximum-scale=1'>" & vbCrLf
	Response.Write "<meta name='apple-mobile-web-app-status-bar-style' content='black'>" & vbCrLf
	Response.Write "<meta name='apple-mobile-web-app-capable' content='yes'>" & vbCrLf
	Response.Write "<meta name='format-detection' content='telephone=no'>" & vbCrLf
	Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""../fonts/font-awesome/css/font-awesome.min.css"" />" & vbCrLf
	Response.Write "<link href='../Plugins/layui/css/layui.css' rel='stylesheet' type='text/css' />" & vbCrLf
	Response.Write "<link href='../Style/global.css' rel='stylesheet' type='text/css' />" & vbCrLf
	Response.Write "<link href='../Style/font.css' rel='stylesheet' type='text/css' />" & vbCrLf
	Response.Write "<script type='text/javascript'>" & vbCrLf
	Response.Write "var pc_file = '" & InstallDir & "';" & vbCrLf
	Response.Write "var admin_file = '" & AdminFolder & "/';" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.Write "<script type='text/javascript' src='../Js/Admin.js'></script>" & vbCrLf
	Response.Write "<script type='text/javascript' src='../../Dialog/main.js'></script>" & vbCrLf
	Response.Write "<script type='text/javascript' src='../../Dialog/lhgcore.min.js'></script>" & vbCrLf
	Response.Write "<script type='text/javascript' src='../../Dialog/lhgcalendar.min.js'></script>" & vbCrLf
	Response.Write "<script type=""text/javascript"" src=""../Plugins/layui/layui.js""></script>" & vbCrLf
	Response.Write "</head>" & vbCrlf
	Response.Write "<body>" & vbCrlf
	Response.Write "<form class='layui-form layui-form-pane' id=""myform"" name=""myform"" action='?Action=DoClear' method=post>" & vbCrlf
	Response.Write "<div class=""admin-main fadeInUp animated"">" & vbCrlf
	Response.Write "    <fieldset class=""layui-elem-field layui-field-title"">" & vbCrlf
	Response.Write "        <legend>附件清理</legend>" & vbCrlf
	Response.Write "    </fieldset>" & vbCrlf
	Response.Write "    <blockquote class=""layui-elem-quote"">" & vbCrlf
	Response.Write "        <a href=""javascript:void(0);"" onClick=""parent.tab.tabAdd({'id': 1,'href': 'Admin\/Admin_UploadFile.asp','title': '\u9644\u4ef6\u7ba1\u7406'});"" class=""layui-btn layui-btn-sm layui-btn-normal"">" & vbCrlf
	Response.Write "            <i class=""fa fa-folder-open""></i> 附件管理" & vbCrlf
	Response.Write "        </a>" & vbCrlf
	If ChannelID = "" Then ChannelID = 1
	Sql = "Select * From Channel Where ChannelHidden=" & WK_False & " Order By ChannelOrder Asc,ChannelID Asc"
	Call Exec(Rs,Sql,2)
	If rs.BOF And rs.EOF Then
		rs.Close
		Set rs = Nothing
	Else
		Do While Not rs.EOF
			Response.Write "        <a href=""?ChannelID=" & rs("ChannelID") & """ class=""layui-btn layui-btn-sm" & Check_Object2(Trim(rs("ChannelID")),ChannelID," layui-btn-danger") & """>" & vbCrlf
			Response.Write "            <i class=""fa fa-"
			If rs("ModuleType")=2 Then
				Response.Write "image"
			ElseIf rs("ModuleType")=3 Then
				Response.Write "download"
			ElseIf rs("ModuleType")=4 Then
				Response.Write "shopping-cart"
			Else
				Response.Write "list"
			End If
			Response.Write """></i> "&rs("ChannelTit")&"附件清理" & vbCrlf
			Response.Write "        </a>" & vbCrlf
			rs.MoveNext
		Loop
		rs.Close
		Set rs = Nothing
	End If
	Response.Write "    </blockquote>" & vbCrlf
	Response.Write "    <fieldset class=""layui-elem-field"">" & vbCrlf
	Response.Write "        <legend>注意：</legend>" & vbCrlf
	Response.Write "        <div class=""layui-field-box"">" & vbCrlf
	ObjInstalled_FSO = IsObjInstalled(Fso_Sys)
	If ObjInstalled_FSO = False Then
		Response.Write "            <b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)! 不能使用本功能</font></b>" & vbCrlf
		Response.End()
	End If
	Response.Write "            在添加内容时，经常会出现上传了图片后但却最终没有使用的情况，时间一久，就会产生大量无用垃圾文件。所以需要定期使用本功能进行清理。<br>如果附件很多，或者信息数量较多，执行本操作需要耗费相当长的时间，请在访问量少时执行本操作。" & vbCrlf
	Response.Write "        </div>" & vbCrlf
	Response.Write "    </fieldset>" & vbCrlf
	Response.Write "    <div class=""layui-form-item"">" & vbCrlf
	Response.Write "        <div class=""layui-input-block"">" & vbCrlf
	Response.Write "            <input name='Action' type='hidden' id='Action' value='DoClear'>" & vbCrlf
	Response.Write "            <input name='ChannelID' type='hidden' id='ChannelID' value='" & ChannelID & "'>" & vbCrlf
	Response.Write "            <button type=""button"" class=""layui-btn"" lay-submit="""" lay-filter=""submit"">开始清理</button>" & vbCrlf
	Response.Write "        </div>" & vbCrlf
	Response.Write "    </div>" & vbCrlf
	Response.Write "</div>" & vbCrlf
	Response.Write "</form>" & vbCrlf
	Response.Write "<script>" & vbCrlf
	Response.Write "layui.use(['form'], function () {" & vbCrlf
	Response.Write "    var form = layui.form;" & vbCrlf
	Response.Write "    //提交监听" & vbCrlf
	Response.Write "    form.on('submit(submit)', function (data) {" & vbCrlf
	Response.Write "        loading = layer.load(1, {shade: [0.1,'#fff']});" & vbCrlf
	Response.Write "        $.ajax({" & vbCrLf
	Response.Write "            type: 'post'," & vbCrLf
	Response.Write "            url: '?Action=DoClear'," & vbCrLf
	Response.Write "            data: data.field," & vbCrLf
	Response.Write "            dataType: 'json'," & vbCrLf
	Response.Write "            success: function(res) {" & vbCrLf
	Response.Write "                layer.close(loading);" & vbCrlf
	Response.Write "                if(res.code > 0){" & vbCrlf
	Response.Write "                    layer.msg(res.msg,{icon: 1, time: 1000},function(){" & vbCrlf
	Response.Write "                        location.href = res.url;" & vbCrlf
	Response.Write "                    });" & vbCrlf
	Response.Write "                }else{" & vbCrlf
	Response.Write "                    layer.msg(res.msg,{icon: 2, time: 1000});" & vbCrlf
	Response.Write "                }" & vbCrlf
	Response.Write "            }" & vbCrLf
	Response.Write "        });" & vbCrLf
	Response.Write "    });" & vbCrlf
	Response.Write "});" & vbCrlf
	Response.Write "</script>" & vbCrlf
	Response.Write "</body>" & vbCrLf & "</html>"
End Sub


Sub DoClear()
	If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
		ChannelID = Code_CLng(Trim(Code_Form("ChannelID")))
		ObjInstalled_FSO = IsObjInstalled(Fso_Sys)
		If ObjInstalled_FSO = True Then
			Set Fso = Server.CreateObject(Fso_Sys)
		Else
			Response.Write "{""code"":0,""msg"":""FSO\u7ec4\u4ef6\u4e0d\u53ef\u7528\uff0c\u5404\u79cd\u4e0eFSO\u76f8\u5173\u7684\u529f\u80fd\u90fd\u5c06\u51fa\u9519\uff01\u8bf7\u5230\u540e\u53f0\u7f51\u7ad9\u914d\u7f6e\u5904\u8bbe\u7f6e\u597dFSO\u7ec4\u4ef6\u540d\u79f0\u3002""}" & vbCrLf
			Response.End()
		End If
		If ChannelID="" Then
			Response.Write "{""code"":0,""msg"":""\u9891\u9053ID\u4e0d\u80fd\u4e3a\u7a7a\uff01""}" & vbCrLf
			Response.End()
		End If
		Dim rs, sql, i, j
		If ChannelID > 0 Then
			sqlChannel = "select * from Channel where ChannelID=" & Code_CLng(ChannelID)
			Call Exec(rsChannel,sqlChannel,2)
			If rsChannel.BOF And rsChannel.EOF Then
				ModuleType = ""
				rsChannel.Close
				Set rsChannel = Nothing
			Else
				ModuleType = rsChannel("ModuleType")
				rsChannel.Close
				Set rsChannel = Nothing
			End If
		End If
		Select Case ModuleType
		Case 2
			cSQL = ",PhotoUrl"
		Case 3
			cSQL = ",DownloadUrl"
		Case Else
			cSQL = ""
		End Select
		sql = "select ClassPic from Class where ChannelID=" & ChannelID
		Call Exec(Rs,Sql,2)
		Do While Not rs.EOF
			If rs(0) <> "" Then
				strFiles = strFiles & "|" & Replace(rs(0),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
			End If
			rs.MoveNext
		Loop
		rs.Close
		Set rs = Nothing
		sql = "select Pic,UploadFiles,Content" & cSQL & " from " & ChannelDataName & " where ChannelID=" & ChannelID
		Call Exec(Rs,Sql,2)
		Do While Not rs.EOF
			If rs(0) <> "" Then
				strFiles = strFiles & "|" & Replace(rs(0),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
			End If
			If rs(1) <> "" Then
				If Instr(rs(1),"@@@") >0 Then
					StrDownloadUrl=Split(rs(1),"@@@")
					For i=0 to Ubound(StrDownloadUrl)
						strFiles = strFiles & "|" & Replace(StrDownloadUrl(i),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
					Next
				Else
					strFiles = strFiles & "|" & Replace(rs(1),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
				End If
			End If
			If ModuleType=2 Or ModuleType=3 Then
				If rs(3) <> "" Then
					If Instr(rs(3),"@@@") >0 Then
						StrDownloadUrl=Split(rs(3),"@@@")
						For i=0 to Ubound(StrDownloadUrl)
							strFiles = strFiles & "|" & Replace(StrDownloadUrl(i),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
						Next
					Else
						strFiles = strFiles & "|" & Replace(rs(3),"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
					End If
				End If
			End If
			If rs(2) <> "" Then
				ItemIntro = ItemIntro & "|" & rs(2)
			End If
			rs.MoveNext
		Loop
		rs.Close
		Set rs = Nothing
		
		Dim tempStr, tempi, TempArray
		UpFileType = "gif|jpg|jpeg|jpe|bmp|png"
		regEx.Pattern = "<img.+?[^\>]>" '查询内容中所有 <img..>
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "src\s*=\s*.+?\.(" & UpFileType & ")" '查询src =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "src\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr
		
		UpFileType = "swf"
		regEx.Pattern = "<embed.+?[^\>]>" 
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "src\s*=\s*.+?\.(" & UpFileType & ")" '查询value =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "src\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr
		
		UpFileType = "flv"
		regEx.Pattern = "<param\s*name\s*=\s*""*flashvars""*.+?[^\>]>"
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "value\s*=\s*.+?\.(" & UpFileType & ")" '查询value =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "value\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr
		
		UpFileType = "wmv|wma"
		regEx.Pattern = "<param\s*name\s*=\s*""*url""*.+?[^\>]>"
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "value\s*=\s*.+?\.(" & UpFileType & ")" '查询value =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "value\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr	
		
		UpFileType = "rm|ra|mov"
		regEx.Pattern = "<param\s*name\s*=\s*""*src""*.+?[^\>]>" 
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "value\s*=\s*.+?\.(" & UpFileType & ")" '查询value =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "value\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr
		
		UpFileType = "mp3|avi|asf|mpg|mpeg|wav|mid|midi"
		regEx.Pattern = "<param\s*name\s*=\s*""*filename""*.+?[^\>]>"
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "value\s*=\s*.+?\.(" & UpFileType & ")" '查询value =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "value\s*=\s*" '过滤 src =
			tempStr = regEx.Replace(tempStr, "")
		End If
		
		strFiles = strFiles & tempStr
			
		UpFileType = "rar|zip|pdf|doc|xls|ppt|chm|hlp"
		regEx.Pattern = "<a.+?[^\>](rar\""*\s*|zip\""*\s*|pdf\""*\s*|doc\""*\s*|xls\""*\s*|ppt\""*\s*|chm\""*\s*|hlp\""*\s*)>" '查询内容中所有含rar，zip，pdf，doc，xls，ppt，chm，hlp名字的附件
		Set Matches = regEx.Execute(ItemIntro)
		For Each Match In Matches
			If tempStr <> "" Then
				tempStr = tempStr & "|" & Match.value '累计数组
			Else
				tempStr = Match.value
			End If
		Next
		
		If tempStr <> "" Then
			TempArray = Split(tempStr, "|") '分割数组
			tempStr = ""
			For tempi = 0 To UBound(TempArray)
				regEx.Pattern = "href\s*=\s*.+?\.(" & UpFileType & ")" '查询href =内的链接
				Set Matches = regEx.Execute(TempArray(tempi))
				For Each Match In Matches
					If tempStr <> "" Then
						tempStr = tempStr & "|" & Match.value '累加得到 链接加$Array$ 字符
					Else
						tempStr = Match.value
					End If
				Next
			Next
		End If
		If tempStr <> "" Then
			regEx.Pattern = "href\s*=\s*" '过滤 href =
			tempStr = regEx.Replace(tempStr, "")
		End If
		strFiles = strFiles & tempStr					
		
		strFiles = LCase(strFiles)
		
		i = 0
		j = 0
		If Fso.FolderExists(Server.MapPath(InstallDir & UploadSetting(1) & "/" & ChannelUploadDir)) = False Then
			Response.Write "{""code"":0,""msg"":""\u627e\u4e0d\u5230\u6587\u4ef6\u5939\uff01\u8bf7\u4e0a\u4f20\u6587\u4ef6\u540e\u518d\u8fdb\u884c\u7ba1\u7406\uff01""}" & vbCrLf
			Response.End()
			Exit Sub
		End If
		
		Set theFolder = Fso.GetFolder(Server.MapPath(InstallDir & UploadSetting(1) & "/" & ChannelUploadDir))
		For Each theFile In theFolder.Files
			If InStr(strFiles, LCase(theFile.name)) <= 0 Then
				theFile.Delete True
				i = i + 1
			End If
		Next
		For Each theSubFolder In theFolder.SubFolders
			For Each theFile In theSubFolder.Files
				If InStr(strFiles, LCase(theSubFolder.name & "/" & theFile.name)) <= 0 Then
					theFile.Delete True
					i = i + 1
				End If
			Next
			Set Cls = New Cls_FileSystem
			If Fso.GetFolder(Server.MapPath(InstallDir & UploadSetting(1) & "/" & ChannelUploadDir & "/" & theSubFolder.name)).Files.Count=0 Then
				Cls.Del_Folder InstallDir & UploadSetting(1) & "/" & ChannelUploadDir & "/" & theSubFolder.name
				j = j + 1
			End If
			Set Cls = Nothing
		Next
		
		SqlAttachment = "Select * From [{prefix}Attachment] Where ChannelID=" & ChannelID & " Order By ID Desc"
		Call Exe_Conn(RsAttachment,SqlAttachment,1)
		If RsAttachment.BOF And RsAttachment.EOF Then
		Else
			Do While Not RsAttachment.Eof
				Set Cls = New Cls_FileSystem
				If Cls.Chk_Exist(RsAttachment("filepath"),0) Then
					If Fso.GetFolder(Server.MapPath(RsAttachment("filepath"))).Files.Count=0 Then
						Cls.Del_Folder RsAttachment("filepath")
					End If
				End If
				If Cls.Chk_Exist(RsAttachment("fullname"),1) = False Then
					Call Exec("","Delete From [{prefix}Attachment] Where fullname='" & RsAttachment("fullname") & "'",0)
				End If
				Set Cls = Nothing
				RsAttachment.MoveNext
			Loop
			RsAttachment.Close
		End If
		Response.Write "{""code"":1,""msg"":""\u6e05\u7406\u65e0\u7528\u6587\u4ef6\u6210\u529f\uff01<br>\u5171\u5220\u9664\u4e86 <font color=red><b>" & i & "</b></font> \u4e2a\u65e0\u7528\u7684\u6587\u4ef6\u3002<br>\u5171\u5220\u9664\u4e86 <font color=red><b>" & j & "</b></font> \u4e2a\u65e0\u7528\u7684\u6587\u4ef6\u5939\u3002"",""url"":""?ChannelID="&ChannelID&"""}" & vbCrLf
		Response.End()
	End If
End Sub
%>